Pascal Super Library/Pascal Super Library (CW International)(1997).bin/EDIT_UTL/MED295/MED295.PAS

Pascal/Delphi Source File | 1995-02-13 | 35KB | 1,058 lines

program med295;
{
  med295.pas: full screen editor, Version: 295 (of Feb-95).
  (GNU-CopyLeft) Mohsin Ahmed, [e-mail]
  Free for non-commercial use, can be used as an editor toolbox!
  Compiles with: Turbo Pascal 5.0, used and tested on IBM/XT & AT.
  Speed: Good enough on a 286 AT with all range checks on.
  ----------------------------------------------------------------------
  Usage:
    C:\> editor FileName
  Max line length is LineSz (80) chars, it will split longer lines.
  Edit keys:
             BackSpace    :  delete char before cursor.
             Delete       :  delete char under cursor.
             Insert       :  toggle insert/overwrite mode.
             Return       :  Break line in Insert mode, else next line,
             Tab          :  Insert 10 spaces,
             F1,F2        :  +/- Foreground Color.
             F3,F4        :  +/- Background Color.
  << Arrow keys >>
             Left/Right   : Char Left/Right,
             C-Left/Right : Word Left/Right,
             C-Home/End   : Delete to line begin/end,
             Up/Dn        : Prev/Next line,
             PgUp/PgDn    : Prev/Next Page,
             C-PgUp/PgDn  : First/Last Line,
  << Control (C-) keys >>
             C-J          : Join with next line.
             C-T          : Delete word.
             C-Y          : Delete line.
  << Esc (Meta-) keys >>
             M-d          : Delete this line,
             M-D          : Delete lines upto the marked line,
             M-f          : Change current File Name,
             M-j          : Join this and next line,
             M-m          : Mark this line,
             M-p/P        : Put yanked/Yanked line, at eol,
             M-q          : Quit.
             M-r          : Read from another file,
             M-u          : Undo current line, restore deleted line,
             M-x          : Write file and quit,
             M-y/Y        : Yank line, to eol,
             M-w          : Write to another file,
             M-/string    : search for string (case sensitive),

  << SCREEN-LAYOUT >>
  01 Date and Time.                       RowDate
  02 Col,Row,Lines,Mode Info.             RowMode
  03--------------------------            RowTop
  04                                      RowMin
  ..
  19 CurPtr^.prev^.dat
  20 CurPtr^.dat                          Row
  21 CurPtr^.next^.dat
  22                                      RowMax
  23--------------------------            RowBot
  24 Reading/Writing/:ESC-Cmds/FileName   RowMeta
  25 Line Number                          RowNum

  If you have a job, I have the time and skills, send email to
    [e-mail], also try finger [e-mail]
    Tel. [phone] (H) (USA).

--------------------------------------------------------------------------}
uses dos,crt;
Const MaxLines   = 32000;
      LineSz     = 80;       RowDate = 01;     RowMode= 02;
      ESC        = #27;      RowMeta = 24;     RowNum = 25;
      ExtKeyCode = #0;       RowTop  = 03;     RowBot = 23;
      Space      = ' ';      RowMin  = 04;     RowMax = 22;
type  strA = string[20];
      strB = string[LineSz];
      strC = string[255];
     lineptr = ^linerec;
     linerec = record
                 prev, next : lineptr ;
                 data       : StrB  ;
               end;
var TextFile       { file handle for i/o } : text ;
    FileBuffer     { file buffer         } : array[0..20000] of char;
    FileName,      { file for read/write }
    FileNameTmp    { file for tmp read/write } : strA;
    TopPtr,        { ptr to first   line }
    BotPtr,        { ptr to last    line }
    CurPtr,        { ptr to current line }
    LineMark,      { ptr to marked  line }
    tp1, tp2, tp3  { temp ptr            } : lineptr ;
    Row            { current row         } : RowMin..RowMax;
    Col            { current column      } : 0..LineSz+1 ;
    i              { temp var            } : 0..LineSz+1 ;
    LineCount,     { total line count    }
    LastCount,     { previous total line count }
    LastLineNum,   { previous row        }
    LineNumber     { current line number } : 0..MaxLines;
    UnDoCopy,      { copy for 'undo'     }
    TmpCopy,       { For Swapping String }
    YankCopy       { copy for 'yank'     } : StrB ;
    ikey, extkey,  { input key           }
    cmdkey         { esc command key     } : char ;
    InsMode,       { Insert/Overwrite    }
    ReDisplay      { for screen update   } : boolean;

  { ----------------------------------------------------------------------- }

  procedure RingBell;
    begin
    sound( 800 );
    delay( 50 );
    nosound;
    end;
  {----------------------------------------------------------}

  procedure SoundClick;
    begin
    sound( 100 );
    delay(10);
    nosound;
    end;
  { ----------------------------------------------------------------------- }

  { reads in a name of a file, returns false if the input is empty }
  function getname( var FileNameTmp : strA ):boolean;
      begin
      write(' FileName(Tmp): ');
      readln(FileNameTmp);
      getname := ( length( FileNameTmp ) > 0 )
      end;
  { ----------------------------------------------------------------------- }

  { Removes tail spaces from a line, if line ended with a spaces.
    It leaves one space at end of the line.
    It doesn't modify the first char of the line.
  }
  procedure cleartailspaces( p : LinePtr );
      var i : integer;
     begin
     i := length( p^.data );
     while (i > 1) and (p^.data[i] = Space) do { find last non-space }
       i := i-1;
     if i < length( p^.data ) then { leave one space at end }
        begin
        { i:=i+1; added below }
        delete( p^.data, i+2, 255 );
        end;
     end;
  { ----------------------------------------------------------------------- }

  { Removes all leading spaces from a line.
    It doesn't modify the first char of the line.
  }
  procedure clearleadingspaces( p : LinePtr );
      var i : integer;
     begin
     i := 1;
     while(i < length( p^.data)) and (p^.data[i] = Space) do
       { find first non-space }
       i := i+1;
     delete( p^.data, 1, i-1 );
     end;

  { ----------------------------------------------------------------------- }
  { Add BigStr at tp1 and repoint tp1 for next call,
    If BigStr is too big, then
    Split BigStr between col [MinCut,..,LineSize-1] at a space,
    If no space is found then split at col[LineSz-1].
  }
  Const MinCut = 40;
  Procedure addline( var tp1 : LinePtr; BigStr : StrC );
       var cutat : integer;
    begin
    while length( BigStr ) > 0 do
      begin
      new( tp2 );
      if length( BigStr ) > LineSz then       { breakline }
         begin
         cutat := LineSz-1;
         while (cutat > MinCut) and (BigStr[cutat+1] <> ' ') do
            cutat := cutat-1;             { search for a suitable break }
         if BigStr[cutat+1] <> ' ' then            { no break was found }
            tp2^.data := copy( BigStr, 1, LineSz-1 ) + '\'
         else
            tp2^.data := copy( BigStr, 1, cutat );
         delete( BigStr, 1, cutat );
         end
      else
         begin
         tp2^.data := BigStr ;
         BigStr := '';
         end;
      if tp1^.next = nil then
         begin            { currently at last line, add a line }
         tp1^.next := tp2 ;
         tp2^.next := nil ;
         tp2^.prev := tp1 ;
         BotPtr := tp2 ;
         end
      else
         begin            { currently at middle line, insert a line }
         tp3 := tp1^.next ;
         tp2^.prev := tp1;
         tp2^.next := tp3 ;
         tp1^.next := tp2 ;
         tp3^.prev := tp2 ;
         end;             { note: we cannot add before line 1 }
      tp1 := tp2 ;
      LineCount := LineCount +1;
      gotoxy(3,RowNum); write(' Line ', LineCount ) ;
      if length( BigStr ) > 0 then
         begin
         soundclick;
         write('Line Split at ',cutat:2);
         end;
      clreol;
      end; { while }
    end;
  {----------------------------------------------------------------------- }

  procedure readfile( FileName: StrA );
       var bigstr : strC;
     begin{readfile}
     assign( TextFile ,FileName );
     settextbuf( TextFile, FileBuffer );
     {$I-} reset( TextFile ); {$I+}
     if IOResult = 0 then
        begin
        gotoxy(3,RowMeta); clreol; write('Reading: ',FileName);
        tp1 := CurPtr ;
        while not eof( TextFile ) do
           begin
           readln( TextFile, bigstr ) ;
           addline( tp1, bigstr );
           end; { while not eof }
        close( TextFile );
        ReDisplay := true;
        end { IoResult = 0 }
     else
        begin
        gotoxy(3,RowMeta); clreol; write('Cannot Read: ',FileName);
        RingBell;
        delay(500);
        end;
     end{readfile};
  { ----------------------------------------------------------------------- }

  procedure writefile( FileName: StrA );
       var TmpData : strB ;
           ThisLine: integer;
     begin{writefile}
     gotoxy(3,RowMeta); clreol; write('Writing : ',FileName);
     assign( TextFile, FileName );
     settextbuf( TextFile, FileBuffer );
     {$I-} rewrite( TextFile ); {$I+}
     if IOResult <> 0 then
        begin
        gotoxy(1,RowNum); write('Cannot write file: ',FileName );
        RingBell; delay(2000);
        exit;
        end;
     ThisLine := 0;      { start from the beginning }
     tp1 := TopPtr ;
     while tp1 <> nil do
        begin
        ThisLine := ThisLine + 1;
        gotoxy(3,RowNum); write(' Line ', ThisLine:4,' / ', LineCount:4 ) ;
        writeln( TextFile, tp1^.data );
        tp1 := tp1^.next ;
        end; { end while }
     close( TextFile );
     end{writefile};
  { ----------------------------------------------------------------------- }

  var Laststr : StrB;                 { Stores last search string }

  procedure searchstring;
    var
       SearchStr      { Search String       } : StrB;
       FoundPos,      { Pos of SearchStr    }
       FoundLine      { Pos of SearchStr    } : integer;

     begin{searchstring}
     readln( SearchStr );
     if length( SearchStr ) = 0 then  SearchStr := LastStr
     else                             LastStr := SearchStr;
     gotoxy(1,RowNum); write('Searching: <',SearchStr,'>');
     tp1 := CurPtr ;
     FoundLine := LineNumber ;
     FoundPos := 0;
     { search from next line to bottom line }
     while ( FoundPos = 0 ) and ( tp1^.next <> nil ) do
         begin
         tp1 := tp1^.next ;
         FoundLine := FoundLine + 1;
         FoundPos := pos( SearchStr, tp1^.data );
         end; { of search till bottom }
     { Wrap around, and search from top }
     if FoundPos = 0 then
        begin
        tp1 := TopPtr ;
        FoundLine := 1;
        FoundPos :=  pos( SearchStr, tp1^.data );
        while ( FoundPos = 0 ) and ( tp1 <> CurPtr ) do
            begin
            tp1 := tp1^.next ;
            FoundLine := FoundLine + 1;
            FoundPos := pos( SearchStr, tp1^.data );
            end;
        end; { of search from top }
        if FoundPos > 0 then
           begin
           col := FoundPos ;
           LineNumber := FoundLine ;
           CurPtr := tp1 ;
           ReDisplay := true;
           write('- Found on line: ',FoundLine:4);
           end
        else
           begin
           write('- Not Found');
           RingBell;
           end;
     delay( 1000 );
     end{searchstring};
  { ----------------------------------------------------------------------- }

  procedure delete_line( var ThisPtr : LinePtr );
     begin{delete_line}
     UnDoCopy := ThisPtr^.data ;
     YankCopy := UnDoCopy ;
     if (ThisPtr^.prev = nil) and (ThisPtr^.next = nil) then
        { LineCount = 1 }
        begin
        ThisPtr^.data:=Space;
        exit;                  { go back now }
        end
     else if (ThisPtr^.prev = nil) and (ThisPtr^.next <> nil) then
        { first line, LineNumber = 1 }
        begin
        ThisPtr := ThisPtr^.next ;
        ThisPtr^.prev := nil ;
        dispose( TopPtr );
        TopPtr := ThisPtr ;
        LineNumber := 1;
        LineCount := LineCount - 1;
        end
     else if (ThisPtr^.prev <> nil) and  (ThisPtr^.next = nil) then
        { last line, LineNumber = LineCount }
        begin
        ThisPtr := ThisPtr^.prev ;
        ThisPtr^.next := nil ;
        dispose( BotPtr );
        BotPtr := ThisPtr ;
        LineCount := LineCount - 1;
        { LineNumber := LineNumber - 1; }
        LineNumber := LineCount;
        end
     else if (ThisPtr^.prev <> nil) and (ThisPtr^.next <> nil ) then
        { middle line, LineNumber in [ 2 .. LineCount-1 ] }
        begin
        tp1 := ThisPtr^.prev ;
        tp3 := ThisPtr^.next ;
        tp1^.next := tp3 ;
        tp3^.prev := tp1 ;
        dispose( ThisPtr );
        ThisPtr := tp3 ;
        LineCount := LineCount - 1;
        end;
     ReDisplay := true;
     gotoxy(1,RowNum); write('Line ',LineCount,'-',LineNumber,' deleted.');
     { soundclick; }
     gotoxy(1,RowNum); clreol;
     end{delete_line};
  { ----------------------------------------------------------------------- }

  { Break this line into two lines,
    not wrapmode  -> break at current column,
        wrapmode  -> break at word boundary (ie. a space ).
  }
  procedure breakline( wrapmode: boolean );
     var i : integer;
    begin{breakline}
    new( tp2 );
    tp1 := CurPtr ;
    tp2^.next := tp1^.next ;
    tp2^.prev := tp1 ;
    tp1^.next := tp2 ;
    tp3 := tp2^.next ;
    tp3^.prev := tp2 ;
    CurPtr := tp2 ;

    if wrapmode then
      begin
      i := col; { cursor is always ahead of current char, so always -1 }
      while (1 < i) and (tp1^.data[i-1] <> Space) do { find place to break }
         i:= i-1;
      if i < col then { if a word was pulled to next line }
         soundclick;
      if i = 1 then   { the word was too long - upto col = 1, ignore }
         i := col;
      end
    else
      i := col;

    { divide data into two parts at i }
    tp2^.data := copy( tp1^.data, i, length( tp1^.data ) - i +1 );
    delete( tp1^.data, i, length( tp1^.data ) - i + 1 );

    if wrapmode then  col := length( tp2^.data )
    else              col := 1;

    if CurPtr^.next = nil  then
       BotPtr := CurPtr;
    LineCount := LineCount + 1 ;
    LineNumber := LineNumber + 1 ;
    UnDoCopy := CurPtr^.data ;
    ReDisplay := true;
    end{breakline};
  {----------------------------------------------------------}
  procedure goto_previous_line;
     begin
     if CurPtr^.prev <> nil then
          begin
          CurPtr := CurPtr^.prev ;
          LineNumber := LineNumber - 1;
          UnDoCopy := CurPtr^.data ;
          if Row > RowMin then
             begin
             Row := Row-1;
             ReDisplay := false;
             end
          else
             ReDisplay := true;
          end;
     end;
  {----------------------------------------------------------}
  procedure goto_next_line;
     begin
     if CurPtr^.next <> nil then
          begin
          CurPtr := CurPtr^.next ;
          LineNumber := LineNumber + 1;
          UnDoCopy := CurPtr^.data ;
          if Row < RowMax then
             begin
             Row := Row+1;
             ReDisplay := false;
             end
          else
             ReDisplay := true;
          end;
     end;
  { ----------------------------------------------------------------------- }

  { Join this and next line, removing extra spaces
    and respecting word boundaries smartly. 17-Jan-95.
  }
  procedure join_lines;
      var i, j, k, lencp : 0..LineSz;
    begin{join_lines}

    cleartailspaces( CurPtr );
    lencp := length( CurPtr^.data );
    if col < lencp then  { first go to end of line }
       begin
       col := lencp;
       exit;
       end;
    if lencp = LineSz then  { no space to join }
       begin
       gotoxy(1,RowNum); write('This line is full, going to next line.');
       goto_next_line;
       exit;
       end;

    tp2 := CurPtr^.next ;
    if (tp2 <> nil) then
       { so there is a next line to join, and place to join it }
       begin
       col := 1 + lencp;        { keep one space reserved }
       clearleadingspaces( tp2 );
       j := length( tp2^.data );
       k := LineSz - col;      { k+1 cols available on this line }
       i := k;                 { number of chars to move }

       if( i < j ) then  { less space, so find a word break. }
          while( (tp2^.data[i+1] <> Space ) and (0<i) ) do
             i:=i-1;

       if i < 1 then { Not possible to join, you try on next line. }
          begin
          gotoxy(1,RowNum);
          write('Not enough space to join, going to next line.');
          goto_next_line;
          exit;
          end;

       if CurPtr^.data[lencp] <> Space then { need a space at joint }
          CurPtr^.data := CurPtr^.data + Space;

       CurPtr^.data := CurPtr^.data + copy( tp2^.data, 1, i );
       delete( tp2^.data, 1, i );
       UnDoCopy := CurPtr^.data ;

       clearleadingspaces( tp2 );
       { Now if the next line is empty then delete it }
       if length(tp2^.data) = 0 then
         begin
         if (tp2^.next = nil) then { tp2^ is the last line }
            begin
            CurPtr^.next := nil ;
            BotPtr := CurPtr ;
            end
         else                     { tp2^ is the not last line }
            begin
            tp3 := tp2^.next ;
            tp3^.prev := CurPtr ;
            CurPtr^.next := tp3 ;
            end;
         dispose( tp2 );
         LineCount := LineCount - 1;
         end; { length(tp2^.data) = 0 }

       Redisplay := true;
       gotoxy(1,RowNum); write('Joined - this and next lines.');
       { soundclick; }
       end
    else
       begin
       gotoxy(1,RowNum ); write('No more lines to join.');
       delay(100);
       end;
    gotoxy(1,RowNum); clreol;
    end{join_lines};
{ ----------------------------------------------------------------------- }

  procedure delete_last_char;
    begin
    if col > 1 then
       begin
       col := col -1 ;
       delete( CurPtr^.data, col, 1 );
       end
    end;
{ ----------------------------------------------------------------------- }

  procedure delete_last_word;   { Tested 26-Feb-94 }
       var i : integer;
     begin{delete_last_word}
     i := col -1;
     if CurPtr^.data[i] = Space then
        while (i > 1) and (CurPtr^.data[i-1] = Space) do
           i := i-1
     else
        while (i > 1) and (CurPtr^.data[i-1] <> Space) do
           i := i-1;

     delete( CurPtr^.data, i, col-i );
     col := i;
     end{delete_last_word};
{ ----------------------------------------------------------------------- }

  procedure delete_next_word;
     { delete word delimited by space, delete atleast one char }
        var i : integer;
     begin
     if length( CurPtr^.data ) = 1 then
        delete_line( CurPtr )
     else
        begin
        i := col;
        if CurPtr^.data[ col ] = Space then
           while (i < length( CurPtr^.data )) and
                 (CurPtr^.data[i+1] = Space) do
                     i := i + 1
        else
           while (i < length( CurPtr^.data )) and
                 (CurPtr^.data[i+1] <> Space) do
                     i := i + 1;

        delete( CurPtr^.data, col, i+1-col );
        end;
     end;
  {----------------------------------------------------------}

  procedure insert_ten_spaces;
      var i : integer;
     begin
     i := 0 ;
     while (length( CurPtr^.data ) < LineSz) and (i<10) do
        begin
        insert( Space, CurPtr^.data, col );
        col := col + 1 ;
        i := i + 1;
        end ;
     end;
  {----------------------------------------------------------}
  procedure cursor( c : char );   { 07-Jan-94  }
     var { set cursor shape/size }
       cl, ch :  integer;
       result :  registers;
       { record ax,bx,cx,dx,bp,si,di,ds,es,flags : integer; end; }
   begin{cursor}
   result.ah :=  1;
   with result do
    case c of
      'b' {block}  : begin ch := 0; cl := 6; end;
      'd' {double} : begin cl := 1; ch := 6; end;
      'h' {half}   : begin ch := 4; cl := 7; end;
      'l' {line}   : begin ch := 6; cl := 7; end;
      'n' {none}   : begin ch := 8; cl := 1; end;
      't' {top}    : begin ch := 0; cl := 3; end;
      end;
   intr( $10,  result );
   { soundclick; }
   end{cursor};
  { ----------------------------------------------------------------------- }

  var Hour,Minute,Second,Second100,
      Year,Month,Day,DayOfWeek       : word;
  procedure DisplayTime;
     begin
     gettime(Hour,Minute,Second,Second100);
     getdate(Year,Month,Day,DayOfWeek);
     gotoxy(1,RowDate);
     write( 'Date: ',Day:2,'-',Month:2,'-',Year:4,', ',
            'Time: ',Hour:2,':',Minute:2,':',Second:2,'.');
     write('                         (C) [e-mail]');
     clreol;
     end;
  { ----------------------------------------------------------------------- }
  procedure DisplayMode;
     begin
     gotoxy(1,RowMode);
     write('File: ',FileName,', Col: ',col:2,', Line: ', LineNumber:3,
           ', LastLine: ', LineCount:3, ', ');
     if InsMode then  write( 'INS')
     else             write( 'OVR');
     clreol;
     end;
  { ----------------------------------------------------------------------- }
  procedure DisplayScreen;
       var i : integer;
     begin

     gotoxy(1,row); write( CurPtr^.Data );
     if length( CurPtr^.Data ) < LineSz then clreol ;

     { write data to screen }
     if ReDisplay
         {
           or ( LastLineNum <> LineNumber )
           or ( LineCount <> LastCount )
         }
     then
        begin         { line has changed, write prev & next lines }
        {lowvideo;}
        redisplay := false;

        tp1 := CurPtr^.prev ;
        i := row-1;
        while (tp1 <> nil) and (i >= RowMin) do
          begin
          gotoxy(1,i); write( tp1^.data );
          if length( tp1^.data ) < LineSz then clreol;
          tp1 := tp1^.prev;
          i := i-1;
          end;
        while i >= RowMin do
          begin
          gotoxy(1,i); write( '@@@' ); clreol; { No Line Present }
          i := i-1;
          end;

        tp2 := CurPtr^.next ;
        i := row+1;
        while (tp2 <> nil) and (i <= RowMax) do
          begin
          gotoxy(1,i); write( tp2^.data );
          if length( tp2^.data) < LineSz then clreol;
          tp2 := tp2^.next;
          i := i+1;
          end;
        while i <= RowMax do
          begin
          gotoxy(1,i); write( '@@@' ); clreol; { No Line Present }
          i := i+1;
          end;

        LastLineNum := LineNumber ;
        LastCount := LineCount ;
        {normvideo;}
        end;

     gotoxy(col,row);  { place cursor }
     end;
{ ----------------------------------------------------------------------- }

  procedure DisplayBoundary;
    begin { -- draw a double-lined box around the edit window -- }
    gotoxy(1,RowTop) ;
    write(#201);
    for i := 2 to 78 do
      write(#205);
    write(#187);
    gotoxy(1,RowBot) ;
    write(#200);
    for i := 2 to 78 do
      write(#205);
    write(#188);
  end;

  { ----------------------------------------------------------------------- }
  { F1/F2 change (+/-) foreground color,
    F3/F4 change (+/-) background color
  }
  Const Fcolor : integer  = White;  { Initialized Variables }
        Bcolor : integer  = Black;
  procedure ScreenColors( key : char );
     begin
     case key of
         {f1} #59 : Fcolor := (Fcolor +1) ;
         {f2} #60 : Fcolor := (Fcolor -1) ;
         {f3} #61 : Bcolor := (Bcolor +1) ;
         {f4} #62 : Bcolor := (Bcolor -1) ;
         end;
     if Fcolor > 16 then Fcolor := Fcolor -16;
     if Fcolor <  0 then Fcolor := Fcolor +16;
     if Bcolor >  8 then Bcolor := Bcolor -16;
     if Bcolor <  0 then Bcolor := Bcolor +16;
     textcolor( Fcolor );
     textbackground( Bcolor );
     for i := 1 to 25 do
        begin
        gotoxy(1,i); clreol;
        end;
     DisplayBoundary;
     ReDisplay := true;
     end;

  procedure ProcessNormal( ikey : char );
     begin
     case ord( ikey ) of
       { backspace }    8 :     delete_last_char;
       { ^backspace } 127 :     delete_last_word;
       { ^T }          20 :     delete_next_word;
       { ^Y }          25 :     delete_line( CurPtr );
       { tab }          9 :     insert_ten_spaces;
       { ^J }          10 :     join_lines;
       { return }      13 :
         if InsMode then
            breakline( false )  { breakline exactly at current column }
         else { not InsMode, just go to next line }
            begin
            goto_next_line;
            col := 1;
            end;
       { printable key }  32 .. 125  :
          begin
          if not InsMode then  { overwite or insert }
             begin {Overwrite}
             CurPtr^.data[ col ] := ikey;
             col := col + 1;
             if (length( CurPtr^.data ) < col ) and (col < LineSz) then
                CurPtr^.data := CurPtr^.data + Space;
             end
          else
             begin {Insert}
             if length( CurPtr^.data ) < LineSz then
                begin
                insert( ikey, CurPtr^.data, col );
                col := col + 1;
                end
             else if (col >= LineSz) then
                begin
                breakline( true ); { break at a word-boundary }
                insert( ikey, CurPtr^.data, col );
                col := col + 1;
                end
             else
                RingBell;
             end; {Insert}
          end; {printable key}
       end; { case }
     end;
{ ----------------------------------------------------------------------- }
  procedure ProcessMetaKey( cmdkey : char );
     begin
     case cmdkey of
      'u' : {undo}
            begin
            TmpCopy := CurPtr^.data ;
            CurPtr^.data := UnDoCopy ;
            UnDoCopy := TmpCopy ;
            end;
      'f' : {new file}
            begin
            write(',    Current File name : ');
            readln( FileName );
            end;
      '/' : searchstring;
      'y'  : { yank line }
             YankCopy := CurPtr^.data ;
      'Y' :  { yank to end of line }
             YankCopy := copy( CurPtr^.data, col, 255 ) ;
      'p' :  { put below current line, and cursor on it }
             begin
             new( tp2 );
             tp1 := CurPtr ;
             tp2^.next := tp1^.next ;
             tp2^.prev := tp1 ;
             tp1^.next := tp2 ;
             tp3 := tp2^.next ;
             tp3^.prev := tp2 ;
             CurPtr := tp2 ;
             tp2^.data := YankCopy ;
             col := 1 ;
             LineCount := LineCount + 1 ;
             LineNumber := LineNumber + 1 ;
             ReDisplay := true;
             end;
      'j' : join_lines;
      'P' : { Put as many chars as possible at eol }
            insert( CurPtr^.data, YankCopy, col );
      'd' : delete_line( CurPtr );
      'm' : { mark line }
            begin
            LineMark := CurPtr;
            write('   Mark set.');
            delay(100);
            end;
      'D' : { delete lines till mark }
            if LineMark <> Nil then
                begin
                while (CurPtr <> LineMark) and (CurPtr <> BotPtr) do
                    delete_line( CurPtr );
                LineMark := Nil; { unset mark after deletion }
                ReDisplay := true;
                end
            else
                begin
                write('    Mark not set ?');
                { RingBell; }
                delay(100);
                end;
      'w' : if getname( FileNameTmp ) then
                writefile( FileNameTmp );
      'r' : if getname( FileNameTmp ) then
                readfile( FileNameTmp );
      end; { case cmdkey }
     end;
{ ----------------------------------------------------------------------- }
  procedure ProcessExtKey( extkey : char );
     begin
     case extkey of
         {home} #71  : col := 1;
         {end}  #79  : col := length( CurPtr^.data );
         {^home}#119 : begin
                       delete( CurPtr^.data, 1, col-1 );
                       col := 1;
                       end;
         {^end}#117  : begin
                       delete( CurPtr^.data, col+1, 255 );
                       end;
         {l-ar}#75   : col := col -1 ;
         {r-ar}#77   :
                begin
                col := col + 1 ;
                if ( col > length( CurPtr^.data ) ) and
                   ( length( CurPtr^.data ) < LineSz )
                then
                  insert( Space, CurPtr^.data,length( CurPtr^.data)+1);
                end;
         {c-l-ar}#115 :
                  begin
                  if col = 1 then
                    begin
                    goto_previous_line;
                    col := length( CurPtr^.data );
                    end
                  else
                    begin
                    repeat
                      col := col-1;
                      until (col <= 1) or
                            ((CurPtr^.data[col-1] = Space) and
                             (CurPtr^.data[col] <> Space) );
                    end;
                  end;
         {c-r-ar}#116 :
                  begin
                  if (col = length( CurPtr^.data)) then
                    begin
                    goto_next_line;
                    col := 1;
                    end
                  else
                    begin
                    repeat
                      col := col+1;
                      until (col >= length( CurPtr^.data)) or
                            ((CurPtr^.data[col-1] = Space) and
                             (CurPtr^.data[col] <> Space) );
                    end;
                  end;
         {u-ar}#72 : goto_previous_line;
         {d-ar}#80 : goto_next_line;
         {pg-up}#73 :
                begin
                i := 1;
                while (i <= 15) and (CurPtr^.prev <> nil) do
                     begin
                     CurPtr := CurPtr^.prev ;
                     LineNumber := LineNumber - 1;
                     i := i+1;
                     ReDisplay := true;
                     end;
                if i > 1 then
                   UnDoCopy := CurPtr^.data ;
                end;
         {pg-dn}#81 :
                begin
                i := 1;
                while (i <= 15) and (CurPtr^.next <> nil) do
                     begin
                     CurPtr := CurPtr^.next ;
                     LineNumber := LineNumber + 1;
                     i := i+1;
                     ReDisplay := true;
                     end;
                if i > 1 then
                     UnDoCopy := CurPtr^.data ;
                end;
         {c-pg-up}#132 :
                if CurPtr <> TopPtr then
                   begin
                   CurPtr := TopPtr ;
                   LineNumber := 1 ;
                   UnDoCopy := CurPtr^.data ;
                   ReDisplay := true;
                   end;
         {c-pg-dn}#118 :
                if CurPtr <> BotPtr then
                   begin
                   CurPtr := BotPtr ;
                   LineNumber := LineCount ;
                   UnDoCopy := CurPtr^.data ;
                   ReDisplay := true;
                   end;
         {ins}#82 : begin
                    InsMode := not( InsMode );
                    if InsMode then cursor( 'b' )
                    else            cursor( 'l' );
                    end;
         {del}#83 :
                if ( length( CurPtr^.data ) > 0 ) then
                   delete( CurPtr^.data, col, 1 );
         {f1-f4} #59,#60,#61,#62 :
                screencolors( ExtKey );
        end; { case }
     end;
{ ----------------------------------------------------------------------- }

begin{main}
clrscr;
randomize ;

CheckSnow := true;      { For CGA Color  }
DirectVideo := true;    { No BIOS for IO }

LineCount := 1;         { Always start with a line }
new( CurPtr );
CurPtr^.prev := nil ;
CurPtr^.next := nil ;
CurPtr^.data := '';
TopPtr := CurPtr ;
BotPtr := CurPtr ;

{ readfile always inserts lines or adds lines so delete the first line }
if TopPtr <> BotPtr then
    begin
    CurPtr := CurPtr^.next;
    dispose( CurPtr^.prev );
    CurPtr^.prev := nil ;
    TopPtr := CurPtr;
    LineCount := LineCount - 1;
    end;
LineNumber := 1;
LastLineNum := 0;

if ( paramcount >= 1 ) then
      begin
      FileName := paramstr(1);
      readfile( FileName );
      end
else  FileName := 'editor.tmp';

{ Begin Edit }
col := 1;
row := RowMin;
InsMode := true;
ReDisplay := true;
cursor('b');       { Block cursor for insert-mode }
UnDoCopy := CurPtr^.data ;
YankCopy := '';
LastCount := LineCount ;
cmdkey := Space;
LineMark := nil;
Laststr := Space;
clrscr ;
DisplayBoundary;
repeat  { main loop }

     if length( CurPtr^.data ) =  0 then
        CurPtr^.data := Space;

     { make sure that col in [1,..,datalength] }
     if col < 1 then
        col := 1
     else if col > length( CurPtr^.data ) then
        col := length( CurPtr^.data );

     cursor('n');    { no cursor while screen updates }
     DisplayTime;
     DisplayMode;
     DisplayScreen;
     if InsMode then cursor( 'b' )
     else            cursor( 'l' );


     ikey := readkey; { next key }
     if ( ikey <> ExtKeyCode ) and ( ikey <> ESC ) then
        { nonextended/nonmeta key }
        ProcessNormal( ikey );

     if ( ikey = ExtKeyCode ) then { extended key }
           begin
           extkey := readkey;
           ProcessExtKey( extkey );
           end;

     if ( ikey = ESC ) then
           begin { ESC, read cmdkey }
           gotoxy(3,RowMeta); write('[0-9+-uf/kyYpPjdDwWrRxXq]: ESC-');
           cmdkey := readkey; write( cmdkey );
           ProcessMetaKey( cmdkey );
           gotoxy( 1,RowMeta ); clreol ; { clear Metakey line }
           gotoxy( 1,RowNum ); clreol ; { clear line }
           delay(100);  { so that user can see the input }
           end; { ESC-processing }

  until cmdkey in ['x','X','q','Q'] ;

clrscr;
if cmdkey = 'x' then writefile( FileName );
clrscr;
end{main}.